perm filename CLEFS.OLD[XX,LCS] blob
sn#205522 filedate 1976-03-18 generic text, type T, neo UTF8
00100 SUBROUTINE CLEFS
00200 DIMENSION JPNTR(11),JCLEF(1050),RCMIN(4),KPNTR(11),KCLEF(350)
00300 1,CM(4),LCLEF(350),LPNTR(11)
00400 COMMON /STF/RSTFAC(8),RSTJ2 /PLTR/IPLT,RHT,DIS
00500 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
00600 DATA RCMIN/3.3,10.5,7.0,10.5/,CM/.1,1.5,1.1,1.5/
00700 EQUIVALENCE (R4,RJQ(2)),(J5,JQ(3)),(J9,JQ(7)),(KK,
00800 1 KPNTR(11)),(R6,RJQ(4)),(R5,RJQ(3)),(R8,RJQ(6)),(R7,RJQ(5))
00900 1,(R9,RJQ(7)),(NJR,RJQ(8)),(KJ,JPNTR(11)),(KCLEF,JCLEF(351))
01000 1,(R3,RJQ(1)),(LCLEF,JCLEF(701)),(KL,LPNTR(11))
01100 J5=MOD(J5,100)
01150 IF(J5)J5=-J5
01200 CALL NOZERO(R6)
01300 IF(R7.EQ.0)R7=R6
01400 C IF P7 = 0, IT WILL EQUAL P6.
01500 IF(JA.GT.10)GO TO 9
01600 NAME='CLEF0'
01700 IF(J5.LT.20)GO TO 4
01800 R6=R6*.3
01900 C SIZE FACTORS FOR SPECIAL WORDS, ETC. (PPP, MF, CRESC. ETC.)
02000 R7=R7*.3
02100 GO TO 4
02200 9 IF(NAME.EQ.NJR)GO TO 4
02300 IF(NAME.EQ.0)GO TO 177
02400 IF(NJR.EQ.0)GO TO 4
02500 177 IF(NJR.EQ.0)GO TO 8
02600 C TO PICK UP BASIC DRAW NAME FROM P10
02700 NAME=NJR
02800 GO TO 4
02900 8 TYPE 5
03000 5 FORMAT(' SET P10=1'/)
03100 C LEADS TO PROPER FILE CALL
03200 4 NM=NAME+2*(J5/10)
03300 C DRAW0 HAS ITEMS 0→9; DRAW1, 10→19; ETC. TO DRAW9, 90→99
03400 JEZ=MOD(J5,10)+1
03500 2 IF(NM.EQ.JNM)GO TO 30
03600 IF(NM.EQ.KNM)GO TO 30
03700 IF(NM.EQ.LNM)GO TO 30
03800 C SET P10≠0 TO CHANGE BASIC 'DRAW' NAME.
03900 C JUMP IF ALREADY IN CORE
04000 NPP=0
04100 IF(JA.NE.11)GO TO 1111
04200 C DOESN'T CHECK LOOKUP ON CLEFS AND ALPHA'S.
04300 NPP=-1
04400 IF(LOOKF(NM))GO TO 1111
04500 TYPE 1112,NM
04600 RETURN
04700 1112 FORMAT(1XA5,' -- NOT FOUND')
04800 1111 CALL GETFI2(NM,NPP)
04900 IF(KX)33,133,233
05000 133 KX=-1
05100 JNM=NM
05200 CALL FASTI2(JPNTR,11)
05300 CALL FASTI2(JCLEF,KJ)
05400 C NEW DATA READER 6/74 -- 5/75 HOLDS 3 .DMD FILES IF THEY FIT.
05500 IF(KJ.LE.350)GO TO 30
05600 KX=1
05700 KNM=0
05800 GO TO 30
05900 33 CALL FASTI2(KPNTR,11)
06000 KX=0
06100 IF(KK.GT.350)GO TO 1111
06200 C JUMP BACK IF IT WON'T FIT.
06300 CALL FASTI2(KCLEF,KK)
06400 KNM=NM
06410 KX=1
06500 GO TO 30
06600 233 CALL FASTI2(LPNTR,11)
06700 KX=0
06800 IF(KL.GT.350)GO TO 1111
06900 C JUMP BACK IF IT WON'T FIT.
07000 CALL FASTI2(LCLEF,KL)
07100 LNM=NM
07200 C CHECK THE ABOVE -- FOR P5 HEIGHT CHANGE *********************
07300 C R6 IS SIZE FACTOR
07400 30 IF(J5.GT.3)GO TO 811
07500 IF(JA.NE.3)GO TO 811
07600 C 0=TREB, 1=BASS, 2=ALTO, 3=TENOR(ALTO SHIFTED UP)
07700 C ↑↑↑↑↑↑↑↑ FIXUP SOMEDAY IN .DMD FILES
07800 IF(R5.LT.100)GO TO 812
07900 RSTJ2=.8*RSTJ2
08000 C TO SET HGT. OF MINI CLEFS
08100 R4=R4+CM(JEZ)
08200 C SHIFTS MINIS UP BECAUSE OF WRONG ORIG. POS.??
08300 812 IF(JEZ.NE.4)GO TO 811
08400 R4=R4+2
08500 JEZ=3
08600 C ABOVE IS NOW AT TOP
08700
08800 811 A=R4
08900 R4=A+2.9
08910 C ADJUSTS HEIGHT(??)
09000 CALL CENTX
09100 R4=A
09200
09300 L=JPNTR(JEZ)
09400 IF(NM.EQ.KNM)L=KPNTR(JEZ)+350
09500 IF(NM.EQ.LNM)L=LPNTR(JEZ)+700
09550 IF(L.LE.0)RETURN
09575 C CATCHES IMPOSSIBLE NUMBERS (I HOPE!)
09600 IF(J9.EQ.0)GO TO 31
09700 CALL ROTATE(JCLEF,L)
09800 C R9=P9=DEGREES OF ROTATION (0-360)
09900 IF(KK.GT.350)KX=0
10000 C CHECK TO SEE IF DATA WAS WIPED OUT.
10100 31 IF(R8.EQ.-2)GO TO 32
10200 IF(IPLT)GO TO 77
10300 IF(R8.NE.-1)GO TO 32
10400 C R8=-2 OMITS FILLER DURING PLOT
10500 77 DO 3 K=L+1,JCLEF(L)+L
10600 IF(JCLEF(K).LT.200000000)GO TO 3
10700 JEZ=JCLEF(L)-1
10800 IF(K.GT.L+1)JEZ=JEZ-K+L+1
10900 CALL FILLMS(JEZ,JCLEF(K),R3,CENTR,R6,R7)
11000 GO TO 32
11100 3 CONTINUE
11200 C FILLS ONLY WHEN PLOTING OR R8=-1
11300 32 CALL JDRAW(JCLEF(L),R3,CENTR,RSTJ2,R6,R7)
11400 C 3,POS.,STF,NT# OR CLEF,ITEM#,SIZEX,SIZEY, R8=-1 TO FILL ON CRT
11500
11600 END